unit ConsoleFrm;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  Menus, ComCtrls,Clipbrd, ExtCtrls,Grids;
const
  SeparatorLine = '---------------------------------------------';

  lineFormatError='Ошибка: <%S>';
  lineFormatWarrning='Внимание: <%S>';
  lineFormatDebugTrace='Debug: <%S>';
  lineFormatInfo='Инфо: <%S>';
  lineFormatSummary='Итого Ошибок: %d  Результат: %S';
  lineFormatIsClickable = ' [%S] ';
  lineTextIsClickable  = 'Щелкните для перехода';

//Colors of console
cclInfo:TColor=clDefault;
cclError:TColor=clRed;
cclWarn:TColor=clDefault;
cclDebug:TColor=clYellow;
type
  TMessageType = (msgError,msgWarrning,msgInfo,msgDebugTrace,msgSummary);
  TMessageTypes = Set Of TMessageType;
{**************************************************************************
*   Классы сообщений консоли:
*   TConsoleMsg абстактный родительский класс сообщений консоли
*     виртуальные методы:
*      Constructor Crete();
*      Procedure Click();
*      Function GetReport():String
*   Какой тип сообщения создать выбирается на этапе создания кода
*   Во время выполнения вызываются методы определённые в конкретном классе
*   Основная суть в том, что сообщение может содежать объект и по по счелчку на
*   строке сообщения будут выполненны определённые действия, на пример переход
*   в поле ввода или считываение объекта из базы данных.
*
*   TSeparatorLineConsoleMsg - специальный тип выводит строкe SeparatorLine
*   TSummaryConsoleMsg - специальный тип выводит текст итогового сообщения
      Эти сообщения образуют подвал который формирует процедура формы AddFutter(Text:Strin);
*   TTextConsoleMsg    - сообщение содержащее только текст
*   TEditConsoleMsg    - cообщение содержит объект - поле ввода
*   TGreedConsoleMsg   - сообщение содержит объект - Табличное поле и Col и Row ячейки
*   TDbOConsoleMsg     - абстактный родительский содержит объект - ссылку на запись в БД
*     Потомков определить по мере надобности в других модулях
***************************************************************************}

  { TConsoleMsg }
  TConsoleMsg = Class
  protected
    FMessage:String;
    FMessType:TMessageType;
    FNode:TTreeNode; //Узел поля вывода с которым связано сообщение
    function GetMessage: String;
    function GetFormatMessage: String;virtual;//Возвращает форматированный текст сообщения
    procedure SetNode(ANode:TTreeNode);//Связывает сообщение с узлом Выводит в узел FNode строку GetFormatMessage()
  public
   // constructor Create(AMess:String;AType:TMessageType;APNode:TTreeNode;AWidget:TWinControl;Col,Row:Integer);Virtual;
    constructor Create();Virtual;abstract;
    procedure Click();Virtual;abstract;
    function GetReport():String;Virtual;abstract;//Возвращает подробное описание для вывода в отчет
    property Message:String read GetMessage;
    property MessType:TMessageType read FMessType;
    property Node:TTreeNode read FNode write SetNode;
  end;

  { TSeparatorLineConsoleMsg }
  TSeparatorLineConsoleMsg = Class(TConsoleMsg)

    public
      constructor Create();
      Procedure Click();
      Function GetReport():String;
  end;

  { TSummaryConsoleMsg }

  TSummaryConsoleMsg = class(TConsoleMsg)
    FWarnCount:Integer;
    FErrCount:Integer;
    function GetFormatMessage: String;override;
  public
    constructor Create(AMessage:String;AErrCount,AWarnCount:Integer);
    Procedure Click();override;
    Function GetReport():String;override;
  end;

  { TTextConsoleMsg }

  TTextConsoleMsg=class(TConsoleMsg)
  public
    constructor Create(AMessage:String;AMessType:TMessageType);
    Procedure Click();override;
    Function GetReport():String;override;
  end;

  { TEditConsoleMsg }

  TEditConsoleMsg = Class(TConsoleMsg)
    private
      FWidget:TWinControl;
      function GetFormatMessage: String;override;
    public
    constructor Create(AMessage:String;AMessType:TMessageType;Widget:TWinControl);
    Procedure Click();override;
    Function GetReport():String;override;
    Property Widget:TWinControl read FWidget;
  end;

    { TGreedConsoleMsg }

    TGreedConsoleMsg = Class(TEditConsoleMsg)
    private
      FCol,FRow:Integer;
    public
    constructor Create(AMessage:String;AMessType:TMessageType;AWidget:TWinControl;Col,Row:Integer);
    Procedure Click();override;
  end;

{**************************************************************************
*     Конец определений TConsoleMsg
***************************************************************************}
TMessagesArray = Array of TConsoleMsg;
  { TConsoleForm }
  TConsoleForm = class(TForm)
    btHide: TButton;
    maClear: TMenuItem;
    maCopySelect: TMenuItem;
    maCopyItem: TMenuItem;
    ButtonPanel: TPanel;
    ShowTrace: TMenuItem;
    ShowWarning: TMenuItem;
    ShowInfo: TMenuItem;
    ShowError: TMenuItem;
    SetFilter: TMenuItem;
    PopupMenu1: TPopupMenu;
    mConsole: TTreeView;
    procedure btHideClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
    procedure FormCreate(Sender: TObject);
    procedure FormHide(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure maClearClick(Sender: TObject);
    procedure maCopyItemClick(Sender: TObject);
    procedure maCopySelectClick(Sender: TObject);
    procedure ConsoleAdvancedCustomDrawItem(Sender: TCustomTreeView;
      Node: TTreeNode; State: TCustomDrawState; Stage: TCustomDrawStage;
      var PaintImages, DefaultDraw: Boolean);
    procedure mConsoleCustomDraw(Sender: TCustomTreeView; const ARect: TRect;
      var DefaultDraw: Boolean);
    procedure mConsoleCustomDrawItem(Sender: TCustomTreeView; Node: TTreeNode;
      State: TCustomDrawState; var DefaultDraw: Boolean);
    Function GetMessage(Node:TTreeNode):TConsoleMsg;
    procedure mConsoleDblClick(Sender: TObject);
    procedure ShowInfoClick(Sender: TObject);
  protected
    FMessages:TMessagesArray;
    FTypeFilter:TMessageTypes;
    FWarnCount:Integer;// Счетчик сообщений типа msgWarrning увеличивается при добавлении сообщения сбрасывается при выводе подвала
    FErrCount:Integer;// Счетчик сообщений типа msgError увеличивается при добавлении сообщения сбрасывается при выводе подвала
    procedure DeleteItem(Msg:TConsoleMsg);//Удаляет сообщение и его узел
    procedure ClearView();//Очищает все узлы из TreeView и устонавливет Node сообщения в Nil
    procedure ShowOnly(MessTypes:TMessageTypes);
    procedure ShowAll();
    procedure AddViewItem(Mess:TConsoleMsg);//Создаёт узел в TreeView и связывает его с сообщением
    function AllUnCheked():Boolean;
//    procedure ShowFiltred();
  private
    FShowFiltred: Boolean;
    procedure SetShowFiltred(AValue: Boolean);
    procedure SetFilterSet(MenuItem:TMenuItem);
    { private declarations }
  public
    { public declarations }
    Procedure Clear;
    Procedure AddTextMessage(Mess:String;MessType:TMessageType);
    Procedure AddMessage(Mess:TConsoleMsg);
    Procedure AddFutter(AFuterMess:String);
    Property TypeFilter:TMessageTypes read FTypeFilter write FTypeFilter;
    Property Filtred:Boolean read FShowFiltred write SetShowFiltred;
  end;
const
 MessageTypes:TMessageTypes = [msgDebugTrace,msgError,msgInfo,msgWarrning,msgSummary];
var
  ConsoleForm: TConsoleForm;

implementation

{ TGreedConsoleMsg }

constructor TGreedConsoleMsg.Create(AMessage: String; AMessType: TMessageType;
  AWidget: TWinControl; Col, Row: Integer);
begin
  inherited Create(AMessage, AMessType, AWidget);
  FCol:=Col;
  FRow:=Row;
end;

procedure TGreedConsoleMsg.Click;
begin
  //inherited Click;
  If FWidget.CanFocus then
     FWidget.SetFocus
  else
   begin
     { TODO -oleo : Реализовать Переход к неактивному элементу }
   end;
  TStringGrid(FWidget).Col:=FCol;
  TStringGrid(FWidget).Row:=FRow;
end;

{ TEditConsoleMsg }

function TEditConsoleMsg.GetFormatMessage: String;
begin
  Result:=inherited GetFormatMessage;
  if FWidget<>nil then Result:=Result+Format(lineFormatIsClickable,[lineTextIsClickable]);
end;

constructor TEditConsoleMsg.Create(AMessage: String; AMessType: TMessageType;
  Widget: TWinControl);
begin
  FMessage:=AMessage;
  FMessType:=AMessType;
  FWidget:=Widget;
end;

procedure TEditConsoleMsg.Click;
begin
  FWidget.SetFocus;
end;

function TEditConsoleMsg.GetReport: String;
begin
  Result:=TConsoleMsg(Self).GetFormatMessage;
end;

{ TTextConsoleMsg }

constructor TTextConsoleMsg.Create(AMessage: String; AMessType: TMessageType);
begin
  FMessage:=AMessage;
  FMessType:=AMessType;
end;

procedure TTextConsoleMsg.Click;
begin
  {*NoOp*}
end;

function TTextConsoleMsg.GetReport: String;
begin
  Result:=GetFormatMessage;
end;

{ TSummaryConsoleMsg }
function TSummaryConsoleMsg.GetFormatMessage: String;
begin
  Result:=Format(lineFormatSummary,[FErrCount,FMessage]);
end;

constructor TSummaryConsoleMsg.Create(AMessage: String;AErrCount, AWarnCount: Integer);
begin
  FMessType:=msgSummary;
  FWarnCount:=AWarnCount;
  FErrCount:=AErrCount;
  FMessage:=AMessage;
end;

procedure TSummaryConsoleMsg.Click;
begin
  {*Noop*}
end;

function TSummaryConsoleMsg.GetReport: String;
begin
  Result:=GetFormatMessage;
end;

{ TSeparatorLineConsoleMsg }
constructor TSeparatorLineConsoleMsg.Create;
begin
  FMessType:=msgSummary;
  FMessage:=SeparatorLine;
end;

procedure TSeparatorLineConsoleMsg.Click;
begin
  {*Noop*}
end;

function TSeparatorLineConsoleMsg.GetReport: String;
begin
  Result:='';
end;

{ TConsoleMsg }
function TConsoleMsg.GetMessage: String;
begin
  Result:=FMessage;
end;

function TConsoleMsg.GetFormatMessage: String;
begin
  case FMessType of
    msgError:Result:=Format(lineFormatError,[FMessage]);
    msgWarrning:Result:=Format(lineFormatWarrning,[FMessage]);
    msgDebugTrace:Result:=Format(lineFormatDebugTrace,[FMessage]);
    msgInfo:Result:=Format(lineFormatInfo,[FMessage]);
  else
    begin
      Result:=FMessage;
   end;
  end;
end;

procedure TConsoleMsg.SetNode(ANode:TTreeNode);
begin
  FNode:=ANode;
  if FNode = nil then exit;
    FNode.Text:=GetFormatMessage;
end;

{$R *.lfm}

{ TConsoleForm }

function TConsoleForm.AllUnCheked():Boolean;
begin
  Result:=  Not  ShowError.Checked And
            Not  ShowWarning.Checked And
            Not  ShowTrace.Checked   and
            Not  ShowInfo.Checked;

end;


procedure TConsoleForm.maClearClick(Sender: TObject);
begin
  Clear;
end;

procedure TConsoleForm.FormShow(Sender: TObject);
begin

end;

procedure TConsoleForm.FormHide(Sender: TObject);
begin
      Clear;
end;

procedure TConsoleForm.FormCloseQuery(Sender: TObject; var CanClose: boolean);
begin
  CanClose:=False;
  Hide;
end;

procedure TConsoleForm.btHideClick(Sender: TObject);
begin
  Hide;
end;

procedure TConsoleForm.FormCreate(Sender: TObject);
begin
  FTypeFilter:=[msgSummary];//MessageTypes;
  Filtred:=False;
end;

procedure TConsoleForm.maCopyItemClick(Sender: TObject);
begin
  Clipboard.AsText:=mConsole.Selected.Text;
end;

procedure TConsoleForm.maCopySelectClick(Sender: TObject);
var
  AText:String;
  i: Integer;
begin
  AText:='';
  for i:= 0 to mConsole.SelectionCount-1 do ;
      AText:=AText+mConsole.Selections[i].Text+#13;
  Clipboard.AsText:=AText;
end;

procedure TConsoleForm.DeleteItem(Msg: TConsoleMsg);
begin
  if Msg.Node <> nil then mConsole.Items.Delete(Msg.Node);
  Msg.Free;
end;

procedure TConsoleForm.Clear;
var
  i: Integer;
begin
  for i := 0 to Length(FMessages)-1 do
  begin
     DeleteItem(FMessages[i]);
  end;
  SetLength(FMessages,0);
end;

procedure TConsoleForm.ShowOnly(MessTypes: TMessageTypes);
var
  Node:TTreeNode;
  i: Integer;
begin
  ClearView();
  for i:= 0 to Length(FMessages)-1 do
  begin
    if FMessages[i].MessType in MessTypes then
       begin
         Node:=mConsole.Items.Add(Nil,'');
         FMessages[i].Node:=Node;
         mConsole.BottomItem:=Node;
       end;
  end;
end;

procedure TConsoleForm.ShowAll();
begin
  ShowOnly(MessageTypes);
end;

procedure TConsoleForm.AddViewItem(Mess:TConsoleMsg);
Var
  NewNode:TTreeNode;
begin
  if (Mess.MessType in FTypeFilter) or not Filtred then
  begin
       NewNode:=mConsole.Items.Add(nil,'');
       Mess.Node:=NewNode;
       //if Mess.Widget<> nil then
       //   begin
       //    ChildeNode:=mConsole.Items.AddChild(NewNode,'<Щелкните для перехода>');
       //   end;
       mConsole.BottomItem:=NewNode;
  end;
end;

procedure TConsoleForm.SetShowFiltred(AValue: Boolean);
begin
     FShowFiltred:=AValue;
     if FShowFiltred=True then
          ShowOnly(FTypeFilter)
     else
          begin
            ShowError.Checked:=False;
            ShowWarning.Checked:=False;
            ShowTrace.Checked:=False;
            ShowInfo.Checked:=False;
            ShowAll();
          end;
end;

procedure TConsoleForm.SetFilterSet(MenuItem: TMenuItem);
begin
  if MenuItem = ShowError then
     begin
      if MenuItem.Checked then
         Include(FTypeFilter,msgError)
      else
         Exclude(FTypeFilter,msgError)
     end
  else if MenuItem = ShowTrace then
     begin
      if MenuItem.Checked then
         Include(FTypeFilter,msgDebugTrace)
      else
         Exclude(FTypeFilter,msgDebugTrace)
     end
  else if MenuItem = ShowWarning then
     begin
      if MenuItem.Checked then
         Include(FTypeFilter,msgWarrning)
      else
         Exclude(FTypeFilter,msgWarrning)
     end
  else
      begin
        if MenuItem.Checked then
           Include(FTypeFilter,msgInfo)
        else
           Exclude(FTypeFilter,msgInfo)
   end;
  Filtred:=Not AllUnCheked();
end;


procedure TConsoleForm.ClearView;
var
  i: Integer;
begin
  for i:= 0 to Length(FMessages)-1 do
  begin
    if FMessages[i].Node=Nil then Continue;
    mConsole.Items.Delete(FMessages[i].Node);
    FMessages[i].Node:=Nil;
  end;

end;

procedure TConsoleForm.ConsoleAdvancedCustomDrawItem(Sender: TCustomTreeView;
  Node: TTreeNode; State: TCustomDrawState; Stage: TCustomDrawStage;
  var PaintImages, DefaultDraw: Boolean);
  function GetColor(MessType:TMessageType):TColor;
   begin
     case MessType of
       msgInfo:Result:=cclInfo;
       msgDebugTrace:Result:=cclDebug;
       msgError:Result:=cclError;
       msgWarrning:Result:=cclWarn;
     else
       Result:=clDefault;
     end;
   end;
  function GetFontStyles(MessType:TMessageType):TFontStyles;
   begin
     case MessType of
       msgInfo:Result:=[];
       msgDebugTrace:Result:=[fsItalic];
       msgError:Result:=[fsBold];
       msgWarrning:Result:=[];
     else
       Result:=[];
     end;
   end;
  var
    Mess:TConsoleMsg;
   begin
     //if Not Node.Selected then
        begin
         // DefaultDraw:=False;
          Mess:=GetMessage(Node);
          if Mess=nil then
             Sender.Canvas.Font.Style:=GetFontStyles(msgInfo)
          else
              Sender.Canvas.Font.Style:=GetFontStyles(Mess.MessType);//GetColor(GetMessage(Node).FType);
         // Sender.Canvas.Brush.Color:=clDefault;
         //    Sender.Canvas.TextOut(Node.DisplayRect(True).Left+1,Node.DisplayRect(true).Right+1,Node.Text);
         //   Sender.Canvas.FillRect(Node.DisplayRect(False));
        end
     //else
     //     Sender.Canvas.Font.Style:=[];

end;


procedure TConsoleForm.mConsoleCustomDraw(Sender: TCustomTreeView;
  const ARect: TRect; var DefaultDraw: Boolean);
begin
end;

procedure TConsoleForm.mConsoleCustomDrawItem(Sender: TCustomTreeView;
  Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
end;

function TConsoleForm.GetMessage(Node: TTreeNode): TConsoleMsg;
var
  i: Integer;
begin
  for i := 0 to Length(FMessages)-1 do
  begin
    If FMessages[i].Node = Node then
       begin
            Result:=FMessages[i];
            Exit;
       end;
  end;
  Result:=nil;
end;

procedure TConsoleForm.mConsoleDblClick(Sender: TObject);
Var
  Mess:TConsoleMsg;
begin
     Mess:=GetMessage(TTreeView(Sender).Selected);
     if Mess= nil then exit;
     Mess.Click();
end;

procedure TConsoleForm.ShowInfoClick(Sender: TObject);
begin
     SetFilterSet(TMenuItem(Sender));
end;


procedure TConsoleForm.AddTextMessage(Mess: String; MessType: TMessageType);
Var
 TextMess:TTextConsoleMsg;
begin
  TextMess:=TTextConsoleMsg.Create(Mess,MessType);
  AddMessage(TextMess);
end;

procedure TConsoleForm.AddMessage(Mess:TConsoleMsg);
begin
    SetLength(FMessages,Length(FMessages)+1);
    FMessages[Length(FMessages)-1]:=Mess;
    case Mess.MessType of
      msgWarrning:Inc(FWarnCount);
      msgError:Inc(FErrCount);
    end;
    AddViewItem(Mess);
end;

procedure TConsoleForm.AddFutter(AFuterMess: String);
var
  LineSeparator:TSeparatorLineConsoleMsg;
  Summary:TSummaryConsoleMsg;
begin
  //Разделитель
  LineSeparator:=TSeparatorLineConsoleMsg.Create();
  AddMessage(LineSeparator);
  //Итог
  Summary:=TSummaryConsoleMsg.Create(AFuterMess,FErrCount,FWarnCount);
  AddMessage(Summary);
  //Сбоасываем счетчики
  FWarnCount:=0;
  FErrCount:=0;
end;

end.

